home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 2 / Atari Mega Archive CD - Volume 2.iso / 8bit / cislib_a / getchr.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-22  |  1.5 KB  |  63 lines
  1. FUNCTION GetChar(VAR Key : Char; Wr : Boolean): Integer;
  2.  
  3. (* by Erik Warren *)
  4.  
  5. BEGIN
  6.   GetChar := 1;(* Keep ISO happy *)
  7. #A
  8.  STX _t         ;hold X temporarily
  9. GC EQU 5        ;MSB 6
  10. Wr EQU 7        ;this is _sp stuff
  11. Key EQU 8       ;MSB 9
  12.  LDY #Key       ;stack pointer offset
  13.  LDA (_sp),y    ;pull from stack
  14.  STA _t+1       ;...and store temp.
  15.  INY            ;do same for MSB
  16.  LDA (_sp),y
  17.  STA _t+2
  18.  LDX #iocb1
  19.  LDA #close
  20.  STA iccmd,x 
  21.  JSR ciov       ;jump and close IOCB
  22.  LDA #open
  23.  STA iccmd,x
  24.  LDA #read      ;open for read only
  25.  STA icax1,x
  26.  LDA #$00       ;zero out auxillary two
  27.  STA icax2,x
  28.  LDA #>GC.Name  ;LSB put in buffer
  29.  STA icbal,x    ;...pointer for CIO
  30.  LDA #<GC.Name  ;MSB of device name
  31.  STA icbah,x
  32.  JSR ciov       ;the big jump to open
  33.  STY _t+3       ;hold status
  34.  BMI gc.end     ;end if error
  35.  LDA #getch     ;read 1 char
  36.  STA iccmd,x
  37.  LDA #$00       ;zero out the
  38.  STA icbll,x    ;...buffer length LSB
  39.  STA icblh,x    ;...and MSB
  40.  JSR ciov       ;jump & put char in A
  41.  STY _t+3       ;hold status
  42.  BMI gc.end     ;end on error
  43.  LDY #$00
  44.  STA (_t+1),y   ;char into Key VARiable
  45.  TYA            ;put zero in A
  46.  STA (_t+2),y   ;zero out useless MSB
  47. gc.end LDA _t+3 ;cio error into A
  48.  LDY #GC        ;from _sp
  49.  STA (_sp),y    ;...store the error
  50.  INY
  51.  LDA #$00
  52.  STA (_sp),y    ;zero out MSB of error
  53.  LDA #close
  54.  STA iccmd,x
  55.  JSR ciov       ;jump & close IOCB one
  56.  JMP gc.exit    ;outtahere, folks
  57. GC.Name ASC 'K:' ;Keyboard device
  58.          DB $9B  ;Return char (155)
  59. gc.exit LDX _t   ;compiler safe again
  60. #
  61.   IF Wr THEN Write(Key)
  62. END;(* GetChar function *)
  63.